03 Resumen descomposición

Author

Eddie Aguilar

Patrones de una serie de tiempo:

library("tidyverse")
library("fpp3")
library("tidyquant")
library("timetk")
library("patchwork")
library("scales")
library("fpp2")

Transformaciones y ajustes

Hay que hacer ajustes a los datos para hacerlos lo más sencillos posibles y tener un mejor análisis.

Ajustes de calendario

transacciones_mensuales <- tq_get("GOOG", get = "stock.prices",
                                  from = "2015-01-01") %>% 
summarise_by_time(
    .date_var      =  date, 
    .by            = "month",
    monthly_volume = sum(volume),
    trading_days   = n(),
    mean_volume    = mean(volume)) %>%
  mutate(month     = yearmonth(date)) %>% 
  select(month, everything(), -date) %>% 
  as_tsibble(index = month)

transacciones_mensuales
# A tsibble: 101 x 4 [1M]
      month monthly_volume trading_days mean_volume
      <mth>          <dbl>        <int>       <dbl>
 1 2015 Jan     1004562476           20   50228124.
 2 2015 Feb      651908915           19   34310996.
 3 2015 Mar      772972385           22   35135108.
 4 2015 Apr      847552576           21   40359646.
 5 2015 May      637318000           20   31865900 
 6 2015 Jun      686410000           22   31200455.
 7 2015 Jul     1266380000           22   57562727.
 8 2015 Aug     1074348000           21   51159429.
 9 2015 Sep      959100000           21   45671429.
10 2015 Oct      988772000           22   44944182.
# … with 91 more rows

Graficar tanto el volumen mensual total como el volumen mensual promedio. Hay dos opciones:

  1. Se grafican por seperado y posteriormente se imprimen ambas.
  2. Se usa pivot_longer para juntar ambas variables y sus valores en una sola columna y se usa facet_wrap().
# Opción 1
p1 <- ggplot(data = transacciones_mensuales) + 
  geom_line(aes(x = month, y = monthly_volume)) +
  ylab("Vol. total mensual") + 
  xlab("")

p2 <- ggplot(data = transacciones_mensuales) + 
  geom_line(aes(x = month, y = mean_volume)) +
  ylab("Vol. promedio diario") +
  xlab("")

p1 / p2

# Opción 2

transacciones_mensuales %>% 
  pivot_longer(cols = c(monthly_volume, mean_volume),
               names_to = "variable", values_to = "valor") %>% 
  ggplot(aes(x = month, y = valor)) +
  geom_line() + ylab("Transacciones") + xlab("") +
  facet_wrap(~ variable, ncol = 1, scales = "free_y")

Vemos como tomando en cuenta el promedio de volumen por dias de calendario es mejor que el total de volumen.

p <- global_economy %>% 
  filter(Country == "Mexico") %>% 
  pivot_longer(cols = -c(Country:Year)) %>% 
  ggplot(aes(x = Year, y = value)) +
  geom_line() + facet_wrap(~ name, scales = "free_y")

plotly::ggplotly(p)

Ajustes poblacionales

Ejemplo: El PIB de algunos paises pueen reflejar un crecimiento falso debido a que no es proporcional, al tomar en cuenta la población (Per Capita), nos daremos cuenta que los datos anteriores son muy diferentes a la realidad.

ge <- global_economy %>% 
  filter(Country == "Mexico" | Country == "Iceland" | Country == "Australia")
  # filter(Country %in% c("Mexico", "Iceland", "Australia"))

p3 <- ggplot(ge) + aes(x = Year, y = GDP, color = Country) + 
  geom_line()
 
p3

México ha tenido un mayor crecimiento en PIB que Australia e Islandia, vamos a ver como se ve tomando en cuenta la polación:

ggplot(ge) + aes(x = Year, y = Population, color = Country) +
  geom_line()

p4 <- ggplot(ge) + aes(x = Year, y = GDP / Population, color = Country) +
  geom_line() + ylab("GDP per capita")

p4

Ajustes inflacionarios

Hay que tener en cuenta la tasa o indice de inflación al tratar el valor del dinero a lo largo del tiempo.

Si vemos las ventas de periodicos en Australia:

print_retail <- aus_retail %>%
  filter(Industry == "Newspaper and book retailing") %>%
  group_by(Industry) %>%
  index_by(Year = year(Month)) %>%
  summarise(Turnover = sum(Turnover))
autoplot(print_retail)
Plot variable not specified, automatically selected `.vars = Turnover`

Podemos ver que las ventas bajan a partir de 2010, tomando en cuenta la inflación:

aus_economy <- global_economy %>%
  filter(Code == "AUS")
  # filter(Country == "Australia")

print_retail %>% 
  # unir las tablas print_retail y aus_economy con base en
  # print_retail
  left_join(aus_economy, by = "Year") %>%
  # calculando las ventas sin inflación
  mutate(Adjusted_turnover = Turnover / CPI) %>%
  #
  pivot_longer(
    cols            = c(Turnover, Adjusted_turnover),
    names_to        = "Type",
    values_to       = "Turnover",
    names_transform = list(Type = as_factor) 
  ) %>% 
  # gather es la versión vieja de pivot_longer, por lo tanto ya
  # no se recomienda utilizar
  # gather("Type", "Turnover", Turnover, Adjusted_turnover, factor_key = TRUE) %>%
  ggplot(aes(x = Year, y = Turnover)) +
    geom_line() +
    facet_grid(vars(Type), scales = "free_y") +
    xlab("Years") + ylab(NULL) +
    ggtitle("Turnover for the Australian print media industry")
Warning: Removed 1 row containing missing values (`geom_line()`).

Vemos que en realidad la caída ha sido más grande tomando en cuenta la inflación.

Transformaciones matemáticas

Si la variación o estacionalidad de los datos aumenta o disminuye a lo largo del tiempo, tal vez sea buena idea aplicar una transformación matemática.

Transformaciones logarítmicas

data("JohnsonJohnson") 
autoplot(JohnsonJohnson)+
  ggtitle("Ventas trimestrales de J&J")

Podemos ver que la estacionalidad aumenta y es algo exponencial la gráfica. Podemos probar una transformación logarítmica para contrarestar esto.

autoplot(log(JohnsonJohnson)) +
  ggtitle("Logaritmo de las ventas trim. de J&J")

Transformaciones de potencia

Sacar la raíz cuadrada o cúbica de los datos. \(w_t = y_t^p\)

autoplot(JohnsonJohnson^(1/3)) +
  ggtitle("Logaritmo de las ventas trim. de J&J")

Transformaciones Box-Cox

Familia de transformaciones matemáticas que incluye logaritmos y potencias. Funciona mediante un parámetro (lambda) Y trabaja así:

\(w_t=\)

\({log(y_t), \text{ si }\lambda = 0}.\)

\((y_t^\lambda-1)/\lambda, \text{ en otro caso}.\)

El logaritmo simepre será natural si lambda es 0, si lambda es 1 solo se desplazará hacia abajo, en otro caso la gráfica cambiará su forma utilizando una potencia y un escalado simple.

Saber que valor de lambda usar:

El mejor de lambda es aquel que hace la estacionalidad uniforme en la gráfica.

Ejemplos de diferentes valores:

p5a <- aus_production %>% autoplot(Gas)+ 
  ggtitle("Producción de gas (datos reales)")

p5 <- aus_production %>% autoplot(box_cox(Gas,lambda = -0.5)) + ggtitle("Box-Cox, lambda = -0.5")

p6 <- aus_production %>% autoplot(box_cox(Gas,lambda = 0)) + ggtitle("Box-Cox, lambda = 0 (log)")

p7 <- aus_production %>% autoplot(box_cox(Gas,lambda = 0.1)) + ggtitle("Box-Cox, lambda = 0.1")

p8 <- aus_production %>% autoplot(box_cox(Gas,lambda = 1)) + ggtitle("Box-Cox, lambda = 1")

p5a

(p5 | p6) / (p7 | p8)

Guerrero

Guerrero nos ayuda a seleccionar un valor automático de lambda:

(lambda <- aus_production %>%
  features(Gas, features = guerrero) %>%
  pull(lambda_guerrero))
[1] 0.1095171
aus_production %>% autoplot(box_cox(Gas, lambda))

Componentes de las series de tiempo

Hay dos formas de descomponer la serie de tiempo:

  • Aditiva \[y_t = S_t + T_t + R_t\]
  • Multiplicativa \[y_t = S_t * T_t * R_t\]

Donde: - \(S_t\) es el componente estacional - \(T_t\) es la tendencia-ciclo - \(R_t\) es el residuo

La aditiva es buena opción cuando la magnitud de la fluctuación estacional no cambia en el nivel de la serie. La multiplicativa para cuando sí cambia (como en series de tiempo económicas).

Una alternativa para la descomposición multiplicativa es transformar los datos para evitar la fluctuación en la estacionalidad y ahora poder usar aditiva, entonces tenemos que:

\[y_t = S_t * T_t * R_t \text{ es equivalente a } \log{y_t} = \log{S_t} + \log{T_t} + \log{R_t}\]

Ejemplo de descomposición:

us_retail_employment <- us_employment %>%
  filter(year(Month) >= 1990, Title == "Retail Trade") %>%
  select(-Series_ID)

us_retail_employment
# A tsibble: 357 x 3 [1M]
      Month Title        Employed
      <mth> <chr>           <dbl>
 1 1990 Jan Retail Trade   13256.
 2 1990 Feb Retail Trade   12966.
 3 1990 Mar Retail Trade   12938.
 4 1990 Apr Retail Trade   13012.
 5 1990 May Retail Trade   13108.
 6 1990 Jun Retail Trade   13183.
 7 1990 Jul Retail Trade   13170.
 8 1990 Aug Retail Trade   13160.
 9 1990 Sep Retail Trade   13113.
10 1990 Oct Retail Trade   13185.
# … with 347 more rows
us_retail_employment %>%
  autoplot(Employed) +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail")

Aplicando descomposisión STL:

dcmp <- us_retail_employment %>%
  model(Descomposicion = STL(Employed))
components(dcmp)
# A dable: 357 x 7 [1M]
# Key:     .model [1]
# :        Employed = trend + season_year + remainder
   .model            Month Employed  trend season_year remainder season_adjust
   <chr>             <mth>    <dbl>  <dbl>       <dbl>     <dbl>         <dbl>
 1 Descomposicion 1990 Jan   13256. 13288.      -33.0      0.836        13289.
 2 Descomposicion 1990 Feb   12966. 13269.     -258.     -44.6          13224.
 3 Descomposicion 1990 Mar   12938. 13250.     -290.     -22.1          13228.
 4 Descomposicion 1990 Apr   13012. 13231.     -220.       1.05         13232.
 5 Descomposicion 1990 May   13108. 13211.     -114.      11.3          13223.
 6 Descomposicion 1990 Jun   13183. 13192.      -24.3     15.5          13207.
 7 Descomposicion 1990 Jul   13170. 13172.      -23.2     21.6          13193.
 8 Descomposicion 1990 Aug   13160. 13151.       -9.52    17.8          13169.
 9 Descomposicion 1990 Sep   13113. 13131.      -39.5     22.0          13153.
10 Descomposicion 1990 Oct   13185. 13110.       61.6     13.2          13124.
# … with 347 more rows

Como podemos ver, esto separa los factores de la serie, viendo la tendencia:

us_retail_employment %>%
  autoplot(Employed, color='gray') +
  autolayer(components(dcmp), trend, color='red') +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail")

Viendo los tres componentes (con escala):

p <- components(dcmp) %>% autoplot() + xlab("Year")
plotly::ggplotly(p)

Datos de 2018:

components(dcmp) %>% 
  as_tibble() %>% 
  mutate(Month = as.Date(Month)) %>% 
  filter(Month >= "2018-01-01") %>% 
  ggplot(aes(x = Month, y = Employed)) +
  geom_line() + xlab("Year") +
  scale_x_date(date_breaks = "1 month", date_labels = "%b %y") +
  theme(axis.text.x = element_text(angle = 90))

Datos desestacionalizados

Muchas veces es util quitar el componente estacinal de una serie. A estos datos se les llama ajustados estacionalmente. Es usado en series como el desempleo o crecimiento económico donde no es importante o interesante ver la estacionalidad anual, sino los datos anuales solos.

Los datos destacionalizados están dados por \(y_t - S_t\) en aditiva y \(\frac{y_t}{S_t}\) en multiplicativa.

Ejemplo con el empleo:

us_retail_employment %>%
  autoplot(Employed, color='gray') +
  autolayer(components(dcmp), season_adjust, color='blue') +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail")

Medias móviles

Descomposición clásica usa medias móviles para definir y darle suacización a la tendencia.

Esto se obtiene al promediar los valores de la serie de tiempo dentro de \(k\) periodos alrededor de \(t\). Y se le llama media móvil de orden \(m\). Donde \(m = 2k +1\).

p <- global_economy %>%
  filter(Country == "Mexico") %>%
  autoplot(Exports) +
  xlab("Year") + ylab("% of GDP") +
  ggtitle("Total Mexican exports")

plotly::ggplotly(p)
global_economy %>%
  filter(Country == "Mexico")
# A tsibble: 58 x 9 [1Y]
# Key:       Country [1]
   Country Code   Year         GDP Growth    CPI Imports Exports Population
   <fct>   <fct> <dbl>       <dbl>  <dbl>  <dbl>   <dbl>   <dbl>      <dbl>
 1 Mexico  MEX    1960 13040000000  NA    0.0129   11.7     8.51   38174112
 2 Mexico  MEX    1961 14160000000   5.00 0.0131   10.6     8.41   39394126
 3 Mexico  MEX    1962 15200000000   4.66 0.0133   10.1     8.57   40649588
 4 Mexico  MEX    1963 16960000000   8.11 0.0133    9.95    8.32   41939880
 5 Mexico  MEX    1964 20080000000  11.9  0.0137    9.85    7.63   43264272
 6 Mexico  MEX    1965 21840000000   7.10 0.0141    9.52    7.63   44623043
 7 Mexico  MEX    1966 24320000000   6.10 0.0147    9.01    7.47   46011038
 8 Mexico  MEX    1967 26560000000   5.85 0.0152    9.01    6.87   47429812
 9 Mexico  MEX    1968 29360000000   9.42 0.0155    9.35    7.04   48894019
10 Mexico  MEX    1969 32480000000   3.42 0.0161    9.27    7.55   50423481
# … with 48 more rows

Vamos a aplicar una media móvil de orden 5, esto significa obtener el promedio de 5 periodos, para cada momento \(t\). Por lo tanto, \(m = 2k + 1 = 5\) y \(k = 2\).

mex_exports <- global_economy %>%
  filter(Country == "Mexico") %>%
  mutate(
    `5-MA` = slider::slide_dbl(Exports, mean, 
                               .before   = 2, 
                               .after    = 2,
                               .complete = TRUE)
  )

mex_exports
# A tsibble: 58 x 10 [1Y]
# Key:       Country [1]
   Country Code   Year         GDP Growth    CPI Imports Exports Popula…¹ `5-MA`
   <fct>   <fct> <dbl>       <dbl>  <dbl>  <dbl>   <dbl>   <dbl>    <dbl>  <dbl>
 1 Mexico  MEX    1960 13040000000  NA    0.0129   11.7     8.51 38174112  NA   
 2 Mexico  MEX    1961 14160000000   5.00 0.0131   10.6     8.41 39394126  NA   
 3 Mexico  MEX    1962 15200000000   4.66 0.0133   10.1     8.57 40649588   8.29
 4 Mexico  MEX    1963 16960000000   8.11 0.0133    9.95    8.32 41939880   8.11
 5 Mexico  MEX    1964 20080000000  11.9  0.0137    9.85    7.63 43264272   7.93
 6 Mexico  MEX    1965 21840000000   7.10 0.0141    9.52    7.63 44623043   7.59
 7 Mexico  MEX    1966 24320000000   6.10 0.0147    9.01    7.47 46011038   7.33
 8 Mexico  MEX    1967 26560000000   5.85 0.0152    9.01    6.87 47429812   7.31
 9 Mexico  MEX    1968 29360000000   9.42 0.0155    9.35    7.04 48894019   7.34
10 Mexico  MEX    1969 32480000000   3.42 0.0161    9.27    7.55 50423481   7.37
# … with 48 more rows, and abbreviated variable name ¹​Population
# Opción 1
gg <- mex_exports %>%
  ggplot(aes(x = Year, y = Exports)) + 
  geom_line() +
  xlab("Year") + ylab("Exports (% of GDP)")
  
gg + geom_line(aes(y = `5-MA`), color='red') +
  ggtitle("Total Mexican exports & 5-MA")
Warning: Removed 4 rows containing missing values (`geom_line()`).

# Opción 2
mex_exports %>% 
  autoplot(Exports) + 
  autolayer(mex_exports, `5-MA`, color = "red") +
  xlab("Year") + ylab("Exports (% of GDP)") +
  ggtitle("Total Mexican exports & 5-MA")
Warning: Removed 4 rows containing missing values (`geom_line()`).

Podemos ver que la suavización captura el movimimento principal de la serie.

Diferentes ordenes de media móvil y como afectará lo suave de la curva:

mex_exports <- mex_exports %>%
  mutate(
    `1-MA` = slider::slide_dbl(Exports, mean, 
                               .before = 0, 
                               .after = 0, .complete = TRUE),
    `3-MA` = slider::slide_dbl(Exports, mean, 
                               .before = 1, 
                               .after = 1, .complete = TRUE),
    `7-MA` = slider::slide_dbl(Exports, mean, 
                               .before = 3, 
                               .after = 3, .complete = TRUE),
    `9-MA` = slider::slide_dbl(Exports, mean, 
                               .before = 4, 
                               .after = 4, .complete = TRUE),
    `11-MA` = slider::slide_dbl(Exports, mean, 
                                .before = 5, 
                                .after = 5, .complete = TRUE),
    `15-MA` = slider::slide_dbl(Exports, mean, 
                                .before = 7, 
                                .after = 7, .complete = TRUE),
    `17-MA` = slider::slide_dbl(Exports, mean, 
                                .before = 8, 
                                .after = 8, .complete = TRUE),
    `21-MA` = slider::slide_dbl(Exports, mean, 
                                .before = 10, 
                                .after = 10, .complete = TRUE)
  )


gg <- mex_exports %>%
  ggplot(aes(x = Year, y = Exports)) + 
  geom_line() +
  xlab("Year") + ylab("Exports (% of GDP)")

g1 <- gg +
 geom_line(aes(y = `1-MA`), color='red') +
  ggtitle("1-MA")
g3 <- gg +
 geom_line(aes(y = `3-MA`), color='red') +
  ggtitle("3-MA")
g5 <- gg +
 geom_line(aes(y = `5-MA`), color='red') +
  ggtitle("5-MA")
g7 <- gg +
 geom_line(aes(y = `7-MA`), color='red') +
  ggtitle("7-MA")
g9 <- gg +
 geom_line(aes(y = `9-MA`), color='red') +
  ggtitle("9-MA")
g11 <- gg +
 geom_line(aes(y = `11-MA`), color='red') +
  ggtitle("11-MA")
g15 <- gg +
 geom_line(aes(y = `15-MA`), color='red') +
  ggtitle("15-MA")
g17 <- gg +
 geom_line(aes(y = `17-MA`), color='red') +
  ggtitle("17-MA")
g21 <- gg +
 geom_line(aes(y = `21-MA`), color='red') +
  ggtitle("21-MA")

(g1 | g3 | g5) /
  (g7 | g9 | g11) /
  (g15 | g17 | g21)
Warning: Removed 2 rows containing missing values (`geom_line()`).
Warning: Removed 4 rows containing missing values (`geom_line()`).
Warning: Removed 6 rows containing missing values (`geom_line()`).
Warning: Removed 8 rows containing missing values (`geom_line()`).
Warning: Removed 10 rows containing missing values (`geom_line()`).
Warning: Removed 14 rows containing missing values (`geom_line()`).
Warning: Removed 16 rows containing missing values (`geom_line()`).
Warning: Removed 20 rows containing missing values (`geom_line()`).

# Graficando las 6 series de una misma vez utilizando facetas
mex_exports %>% 
  pivot_longer(
    cols      = `5-MA`:`21-MA`,
    names_to  = "Orden",
    values_to = "Media móvil"
  ) %>% 
  ggplot(aes(x = Year, y = Exports)) + 
  geom_line() + 
  geom_line(aes(y = `Media móvil`), color = "red") +
  xlab("Año") + ylab("Exportaciones (% of PIB)") +
  facet_wrap(~ Orden) +
  theme_minimal()
Warning: Removed 4 rows containing missing values (`geom_line()`).

Medias móviles de medias móviles

A una suavizaciónd de media móvil se le puede aplicar una nueva suavizacióni de media móvil.

Ejemplo: Sacar una media móvil de orden 4 y a eso sacarle la media móvi lde orden 2

beer <- aus_production %>%
  filter(year(Quarter) >= 1992) %>%
  select(Quarter, Beer)

beer_ma <- beer %>%
  mutate(
    `4-MA` = slider::slide_dbl(Beer, mean, .before = 2, .after = 1, .complete = TRUE),
    `2x4-MA` = slider::slide_dbl(`4-MA`, mean, .before = 0, .after = 1, .complete = TRUE)
  )

beer_ma
# A tsibble: 74 x 4 [1Q]
   Quarter  Beer `4-MA` `2x4-MA`
     <qtr> <dbl>  <dbl>    <dbl>
 1 1992 Q1   443    NA       NA 
 2 1992 Q2   410    NA       NA 
 3 1992 Q3   420   451.     450 
 4 1992 Q4   532   449.     450.
 5 1993 Q1   433   452.     450.
 6 1993 Q2   421   449      446.
 7 1993 Q3   410   444      446 
 8 1993 Q4   512   448      443 
 9 1994 Q1   449   438      440.
10 1994 Q2   381   441.     444.
# … with 64 more rows

Al sacar la media móvil de orden 4, tenemos: \[\text{4-MA = }T_t=\frac{1}{4}(y_{t−2}+y_{t−1}+y_t+y_{t+1})\]

Al sacar media móvil de orden 2 a esta media móvil anterior: \[\text{2×4-MA = }T_t=\frac{1}{2}[\frac{1}{4}(y_{t−2}+y_{t−1}+y_t+y_{t+1})+\frac{1}{4}(y_{t−1}+y_t+y_{t+1}+y_{t+2})]\]

Simplificando: \[\text{2×4-MA = }T_t=\frac{1}{8}y_{t−2}+\frac{1}{4}y_{t−1}+\frac{1}{4}y_t+\frac{1}{4}y_{t+1}+\frac{1}{8}y_{t+2}\]

Por lo tanto, la media móvil de una media móvil es simplemente una media móvil ponderada.

medias móviles ponderadas

Entonces, una media móvil ponderada está constituida por dos o más medias móviles.

Teniendo una media móvil de orden \(m\) donde \(k = (m-1)/2\), los pesos o ponderaciones están dados por \([a_{-k},...,a_k]\), los pesos deben sumar 1.

Se puede decir que una media móvil simple m-MA es un caso particular de media móvil ponderada, donde todos sus pesos son iguales a \(1/m\).

us_retail_employment_ma <- us_retail_employment %>%
  mutate(
    `12-MA` = slider::slide_dbl(Employed, mean, .before = 6, .after = 5, .complete = TRUE),
    `2x12-MA` = slider::slide_dbl(`12-MA`, mean, .before = 0, .after = 1, .complete = TRUE)
  )

us_retail_employment_ma %>%
  autoplot(Employed, color='gray') +
  autolayer(us_retail_employment_ma, vars(`2x12-MA`), color='red') +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail, 2x12-MA")
Warning: Removed 12 rows containing missing values (`geom_line()`).

Métodos de descomposición

Descomposición clásica.

Dos tipos: aditiva y multiplicativa. Se asume que el componente estacional es constante a lo largo del tiempo. Es obsoleto, desventajas:

  • No hay estimación de tendencia para las primeras y últimas observaciones.
  • Asume que la estacionalidad se repite año con año, no captura cambios en ese patrón.
us_retail_employment %>%
  model(classical_decomposition(Employed, type = "additive")) %>%
  components() %>%
  autoplot() + xlab("Year") +
  ggtitle("Classical additive decomposition of total US retail employment")
Warning: Removed 6 rows containing missing values (`geom_line()`).

Descomposición X11

Se basa en descomposición clásica con mejoras para atacar sus desventajas, funciona bien para datos trimestrales y mensuales.

x11_dcmp <- us_retail_employment %>%
  model(x11 = feasts:::X11(Employed, type = "additive")) %>%
  components()
Warning: `X11()` was deprecated in feasts 0.2.0.
ℹ Please use `X_13ARIMA_SEATS()` instead.
ℹ You can specify the X-11 decomposition method by including x11() in the model
  formula of `X_13ARIMA_SEATS()`.
autoplot(x11_dcmp) + xlab("Year") +
  ggtitle("Additive X11 decomposition of US retail employment in the US")

x11_dcmp %>% 
  gg_season()
Plot variable not specified, automatically selected `y = Employed`

x11_dcmp %>% 
  gg_subseries(seasonal)

Descomposición SEATS

Seasonal Extraction Arima Time Series. Solo funciona para datos trimestrales o mensuales.

seats_dcmp <- us_retail_employment %>%
  model(seats = feasts:::SEATS(Employed)) %>%
  components()
Warning: `SEATS()` was deprecated in feasts 0.2.0.
ℹ Please use `X_13ARIMA_SEATS()` instead.
ℹ You can specify the SEATS decomposition method by including seats() in the
  model formula of `X_13ARIMA_SEATS()`.
autoplot(seats_dcmp) + xlab("Year") +
  ggtitle("SEATS decomposition of total US retail employment")

Descomposición STL

Seasonal and Trend decomposition using loess (Loess es méotod de estimaciónd e realaciones no lineales).

Ventajas: - Puede tratar con cualquier tipo de estacionalidad, no solo mensual o trimestral. - El componente estacional puede ariar con el tiempo. - La suavización de tendencia es controlado por el usuario. - Es robusto ante outliers.

Desventajas: - No controla automáticamene la variación debido a días hábiles o variaciones por calendario. - Solo descomposiciones aditivas.

us_retail_employment %>%
  model(STL(Employed ~ trend(window=7) + season(window='periodic'),
    robust = TRUE)) %>%
  components() %>%
  autoplot()

# modificando la tendencia
us_retail_employment %>%
  model(STL(Employed ~ trend(window=15) + season(window='periodic'),
    robust = TRUE)) %>%
  components() %>%
  autoplot()

# modificando la estacionalidad
us_retail_employment %>%
  model(STL(Employed ~ trend(window=7) + season(window=21),
    robust = TRUE)) %>%
  components() %>%
  autoplot()

Esta gráfica muestra una descomposición mediante STL, ajustando algunos parámetros (el componente de tendencia es más flexible, el componente estacional es fijo y se agregó la opción de robustez).

Los valores escogidos de los parámetros deben ser impares. Si se desea mantener el mismo componente estacional a lo largo del tiempo, se debería definir como periódico, season(window = “periodic”), como en el caso anterior.